---
title: "NBA Development Analysis"
author: "Jesse Devitt"
output:
flexdashboard::flex_dashboard:
theme:
version: 4
bootswatch: cosmo
primary: "#30D5C8"
orientation: columns
vertical_layout: fill
source_code: embed
---
<style>
.chart-title { /* chart_title */
font-size: 20px;
}
body{ /* Normal */
font-size: 18px;
}
</style>
```{r setup, include=FALSE}
library(flexdashboard)
```
Introduction
===
Column {.tabset data-width=650}
---
### Motivation
<head>
<base target = "_blank">
</head>
<font size=5>
**Title**
</font>
Before I was able to start my analysis, I needed to merge two NBA data sets: one including player salary information, and one including player career statistics and general attributes. My final merged data set contains information from 1984-2018. This time frame completely overlaps with the NBA's greatest time of growth. In this presentation, we look at statistical analysis that attempts to display how the NBA has changed over the past 30+ years, but we will also utilize advanced statistics to find certain league trends and attempt to answer multi-era spanning questions.
### Introduction - Get to know my merged dataset.
```{r}
knitr::opts_chunk$set(echo = TRUE)
library(pacman)
library(tidyverse)
library(plotly)
library(maps)
library(DT)
# **bold** to make bold
# - to make bullet points
```
```{r package_data, echo=FALSE}
NBA_salaries_1985to2018 <- read.csv("~/Library/Mobile Documents/com~apple~CloudDocs/MTH 209/salaries_1985to2018.csv")
NBA_salaries_1985to2018 <- NBA_salaries_1985to2018 %>% select(-(league))
NBA_salaries <- NBA_salaries_1985to2018 %>% group_by(player_id,) %>%
summarize(median_salary = median(salary),
first_season = min(season_start),
last_season = max(season_end))
NBAplayers <- read.csv("~/Library/Mobile Documents/com~apple~CloudDocs/MTH 209/NBAplayers.csv")
NBAplayers <- NBAplayers %>% rename(player_id = X_id)
NBA <- NBAplayers %>% inner_join(NBA_salaries)
temp<- data.frame(do.call("rbind", strsplit(as.character(NBA$birthPlace), ", ", fixed = TRUE)))
NBA$birthcity <- temp[,1]
NBA$birthcountry <- temp[,2]
index <- which(NBA$birthcity %in% c("Tbilisi", "Rustavi")&NBA$birthcountry=="Georgia")
NBA$birthcountry<-ifelse(NBA$birthcountry %in% state.name, "United States", NBA$birthcountry)
NBA$birthcountry<-ifelse(NBA$birthcountry=="District of Columbia", "United States", NBA$birthcountry)
NBA$birthcountry[index]<-"Georgia"
NBA$birthcountry <- as.character(NBA$birthcountry)
NBA$draft_pick <- gsub('[ overallstndrdth]', '', NBA$draft_pick[1:2408])
NBA$draft_pick <- as.numeric(NBA$draft_pick)
NBA$career_WS <- as.numeric(NBA$career_WS)
NBA$career_G <- as.numeric(NBA$career_G)
NBA$draft_year <- as.numeric(NBA$draft_year)
NBA$career_PER <- as.numeric(NBA$career_PER)
NBA$career_FG3. <- as.numeric(NBA$career_FG3.)
NBA$median_salary <- as.numeric(NBA$median_salary)
NBA$career_eFG. <- as.numeric(NBA$career_eFG.)
options(scipen=999)
NBA$position <- NBA$position %>% recode(
`Power Forward` = "F",
`Center` = "C",
`Point Guard` = "G",
`Shooting Guard` = "G",
`Center and Small Forward and Power Forward` = "F/C",
`Power Forward and Small Forward` = "F",
`Center and Power Forward` = "F/C",
`Small Forward` = "F",
`Shooting Guard and Small Forward` = "G/F",
`Shooting Guard and Point Guard` = "G",
`Power Forward and Center` = "F/C",
`Point Guard and Shooting Guard` = "G",
`Shooting Guard and Small Forward and Point Guard` = "G/F",
`Small Forward and Shooting Guard` = "G/F",
`Point Guard and Power Forward and Small Forward and Shooting Guard` = "G/F",
`Small Forward and Power Forward` = "F",
`Small Forward and Power Forward and Shooting Guard` = "G/F",
`Power Forward and Center and Small Forward` = "F/C",
`Small Forward and Center and Power Forward` = "F/C",
`Shooting Guard and Small Forward and Power Forward` = "G/F",
`Shooting Guard and Point Guard and Small Forward` = "G/F",
`Center and Power Forward and Small Forward` = "F/C",
`Power Forward and Shooting Guard` = "G/F",
`Small Forward and Shooting Guard and Power Forward` = "G/F",
`Power Forward and Small Forward and Shooting Guard` = "G/F",
`Small Forward and Shooting Guard and Point Guard` = "G/F",
`Small Forward and Power Forward and Center` = "F/C",
`Small Forward and Point Guard and Shooting Guard` = "G/F",
`Small Forward and Center` = "F/C",
`Shooting Guard and Power Forward and Point Guard` = "G/F",
`Power Forward and Shooting Guard and Small Forward` = "G/F",
`Shooting Guard and Power Forward and Small Forward` = "G/F",
`Point Guard and Shooting Guard and Small Forward` = "G/F",
`Power Forward and Small Forward and Center` = "F/C",
`Point Guard and Small Forward and Shooting Guard` = "G/F",
`Point Guard and Small Forward` = "G/F",)
glimpse(NBA %>% arrange(desc(career_WS)) %>% select(-c(highSchool, player_id, birthcity, shoots, birthPlace, birthDate, draft_round, weight)))
```
Column {data-width=350}
---
### Variable Explanation
**Basic Statistics**
- **career_AST**: Average number of assists earned per game for a player's career
- **career_FG.**: ((Total field goals made) / (Total field goals attempted)) * 100 from a player's entire career.
- **career_FG3.**: ((Total 3-Point field goals made) / (Total 3-Point field goals attempted)) * 100 from a player's entire career.
- **career_FT.**: ((Total free throws made) / (Total free throws attempted)) * 100 from a player's entire career.
- **career_G**: Total career games played
- **career_PTS**: Average number of points scored per game for a player's career
- **career_TRB**: Average number of both offensive and defensive rebounds grabbed per game for a player's career
- **median_salary**: Median annual salary earned for a player's career
**Advanced Statistics**
- **career_PER**: Career player efficiency rating; [PER](https://www.espn.com/nba/columns/story?columnist=hollinger_john&id=2850240) is a player's per-minute productivity that allows us to compare players with differing minutes played per game
- **career_WS**: Career Win Shares Earned; [Win Shares](https://www.basketball-reference.com/about/ws.html) is a player statistic which attempts to divvy up credit for team success to the individual players on the team
- **career_eFG.**: Career effective field goal percentage; [eFG%](https://www.washingtonpost.com/what-is-effective-field-goal-percentage/a7e174de-5c62-4c9d-a687-01457731c1c2_note.html) = (FGM + 0.5 * 3PM) / FGA
- **WS_per_G**: Career Win Shares per Game; this statistic accounts for disparities among NBA players' career lengths by dividing career WS by career games played, thus finding their approximate win shares earned per game.
The NBA: 1985 v. 2018
===
Column {.tabset data-width=550}
---
The following interactive tables show all active players from both the 1985 and 2018 NBA seasons.
### 1985
```{r comparison, echo=FALSE}
# I want to arrange tables by descending PER or WS so table includes more recognizable player names
NBA1985 <- NBA %>% filter(first_season == 1984) %>% arrange(desc(career_PER, na.rm = T))
NBA2018 <- NBA %>% filter(last_season == 2018) %>% arrange(desc(career_PER))
datatable(NBA1985, options = list(
columnDefs = list(list(className = 'dt-center', targets = 5)),
pageLength = 5,
lengthMenu = c(5, 10, 15, 20)
))
```
### 2018
```{r compariso, echo=FALSE}
datatable(NBA2018, options = list(
columnDefs = list(list(className = 'dt-center', targets = 5)),
pageLength = 5,
lengthMenu = c(5, 10, 15, 20)
))
```
NBA Diversity Maps
===
Column {.tabset data-width=1000}
---
Over the past 30 or so years, the NBA has seen a great international diversification, with the past four regular-season MVP awards going to international-born players. These world maps display how international representation within the NBA has grown.
### 1985
```{r map1, echo=FALSE}
map <- map_data("world")
NBA1985_map <- NBA1985 %>% left_join(map, by = c("birthcountry"="region"))
count1985 <- NBA1985 %>% group_by(birthcountry) %>% summarize(count = n())
map1985 <- count1985 %>% left_join(map, by = c("birthcountry" = "region")) %>% filter(birthcountry != "United States")
p1 <- map %>% ggplot() +
geom_polygon(aes(x=long, y = lat, group = group, text = region), fill="grey", alpha=0.5) +
geom_polygon(data = map1985, aes(x = long, y = lat, group = group, fill = count, text = paste0(birthcountry, ":\n", ": ", round(count, 1), " NBA Player"))) +
scale_fill_viridis_c(option = "D") +
theme_void() + labs(title = "NBA International Diversity in 1985") +
theme(legend.position="none")
ggplotly(p1, tooltip = "text")
```
### 2018
```{r map2, echo=FALSE}
count2018 <- NBA2018 %>% group_by(birthcountry) %>% summarize(count = n())
map2018 <- count2018 %>% left_join(map, by = c("birthcountry" = "region")) %>% filter(birthcountry != "United States")
p2 <- map %>% ggplot() +
geom_polygon(aes(x=long, y = lat, group = group, text = region), fill="grey", alpha=0.5) +
geom_polygon(data = map2018, aes(x = long, y = lat, group = group, fill = count, text = paste0(birthcountry, ":\n", ": ", round(count, 1), " NBA Player(s)"))) +
scale_fill_viridis_c(option = "D") +
theme_void() + labs(title = "NBA International Diversity in 2018")
ggplotly(p2, tooltip = "text")
```
How is WS Effected
===
In the NBA, the advanced statistic of Win-share (WS) is one of, if not the best way, of measuring the success of an player's career. Through an advanced statistic, WS measures a players offense, defense, and playing time in order to assign the proportion of team's wins a player has earned.
The following scatter plots display the possible relationships between WS and both draft pick as well as college drafted from. Only players drafted 1st through 60th were considered for both plots, and only the top colleges that have produced the most NBA talent were considered for the second plot.
Column {.tabset data-width=500}
---
### WS vs. Draft Pick
```{r scatter 1, fig.align='center', out.width="85%", echo=FALSE}
NBA_WS <- NBA %>%
group_by(draft_pick, na.rm = T) %>%
filter(draft_year > 1983, draft_pick < 61) %>%
summarize(median_WS = median(career_WS, na.rm = T))
s1 <- ggplot(NBA_WS, aes(x = draft_pick, y = median_WS)) + geom_point(color = "red", na.rm = T) +
theme(text = element_text(size = 12)) +
labs(title = "Distribution Between Draft Pick and Career Win Shares",
y = "Median WS",x = "Draft Pick (1st and 2nd Round Only)") +
scale_color_brewer(palette = "Set2")
ggplotly(s1)
```
### WS vs. College
```{r scatter2, fig.align='center', out.width="85%", echo=FALSE}
college_top10 <- NBA %>% group_by(college) %>% filter(draft_year > 1983, draft_pick < 61) %>% summarize(count = n(), na.rm = T, median_WS = median(career_WS, na.rm = T), median_draftpick = median(draft_pick, na.rm = T)) %>% arrange(desc(count)) %>% head(11)
college_top10 <- college_top10[-1,]
college_top10$count <- as.numeric(college_top10$count)
s2 <- ggplot(college_top10, aes(x = median_WS, y = median_draftpick, color = college,
size = count, text = paste0(college, ":\n", round(count, 1), " NBA Players Produced"))) + geom_point() +
theme(text = element_text(size = 12)) +
labs(title = "Top 10 NBA Alumn Colleges: WS vs Draft Pick",
y = "Median Draft Pick (84'-18')",x = "Median WS") +
scale_color_brewer(palette = "Set3") + theme(legend.position="none")
ggplotly(s2, tooltip = "text")
```
Column {.tabset data-width=500}
---
### Findings
When looking at the draft pick scatterplot, it is clear that there exists a somewhat strong non-linear negative relationship between draft pick and career WS, with numerically-lower picks typically earning more WS throughout their career. This was expected given lower draft picks are usually viewed as greater talent than higher picks.
The next scatter plot contains the top 10 colleges that have produced the most NBA talent during the span of 1984-2018. Although other colleges have produced more NBA players, it is likely that the University of North Carolina produces the highest caliber NBA players since their alumns have the highest median career WS and are more often than not, lottery picks (1-14 in the draft)
Position Development
===
While today's NBA is often described as "positionless", the NBA in 1985 could be described more so as traditional. The game was commonly ran through the center, while that strategy is quite uncommon in today's game.
Although shooting 3-point shots was relatively uncommon in 1985, it was almost unheard of for centers to shoot 3s. However, in today's game, the 3-point shot is vital to a team's success; and due to this, centers have began perfecting their shot.
Column {.tabset data-width=500}
---
### C 3P% Development
```{r scatter3a, fig.align='center', out.width="85%", echo=FALSE}
NBA_3P <- NBA %>%
group_by(draft_year) %>%
filter(position == "C", draft_year > 1983, career_FG3. != 0) %>%
summarize(median_FG3 = median(career_FG3., na.rm = T))
s3a <- ggplot(NBA_3P, aes(x = draft_year, y = median_FG3)) + geom_point(color = "red") + labs(y = "Median 3P% Among NBA Centers", title = "NBA Center Draft Classes and Their Corresponding 3P%",x = "Draft Year")
ggplotly(s3a)
```
### eFG% Development
```{r scatter3b, fig.align='center', out.width="85%", echo=FALSE}
NBA_eFG <- NBA %>%
group_by(draft_year) %>%
filter(draft_year > 1983, career_eFG. != 0) %>%
summarize(median_eFG = median(career_eFG., na.rm = T))
s3b <- ggplot(NBA_eFG, aes(x = draft_year, y = median_eFG)) + geom_point(color = "red") + labs(y = "Median eFG% Among NBA Players", title = "NBA Draft Classes and Their Corresponding eFG%",x = "Draft Year")
ggplotly(s3b)
```
Column {.tabset data-width=500}
---
### 1985 Salaries
```{r histogram1, fig.align='center', out.width="85%", echo=FALSE}
h1<-ggplot(NBA1985 %>% filter(position == "G" | position == "F" | position == "C"), aes(x = position, y = median_salary, fill = position)) +
geom_boxplot() +
labs(x = "NBA Position", y = "Career Median Salary ($)", title = "NBA Salary Distribution by Position in 1985") + scale_x_discrete(labels = c('Center', 'Forward', 'Guard')) + theme(legend.position="none")
ggplotly(h1)
```
### 2018 Salaries
```{r histogram2, fig.align='center', out.width="85%", echo=FALSE}
h2<-ggplot(NBA2018 %>% filter(position == "G" | position == "F" | position == "C"), aes(x = position, y = median_salary, fill = position)) +
geom_boxplot() +
labs(x = "NBA Position", y = "Career Median Salary ($)", title = "NBA Salary Distribution by Position in 2018") + scale_x_discrete(labels = c('Center', 'Forward', 'Guard')) + theme(legend.position="none")
ggplotly(h2)
```
Efficiency Analysis
===
A popular modern debate in the NBA has been of the league's all-time best draft class. The first scatter plot shows the top-10 draft classes by median PER, to display overall player efficiency, and median WS, to display overall career success.
Column {.tabset data-width=1000}
---
### Draft Classes
```{r scatter4, fig.align='center', out.width="90%", echo=FALSE}
best_NBAclass <- NBA %>% group_by(draft_year) %>% filter(draft_year > 1983, draft_pick < 61) %>% summarize(max_PER = max(career_PER), max_WS = max(career_WS), median_PER = median(career_PER, na.rm = T), median_WS = median(career_WS, na.rm = T)) %>% arrange(desc(median_WS), desc(median_PER)) %>% head(10)
best_NBAclass$draft_year <- as.character(best_NBAclass$draft_year)
s4 <- ggplot(best_NBAclass, aes(x = median_PER, y = median_WS, label = draft_year)) +
theme(text = element_text(size = 13)) +
labs(title = "Efficiency Distribution of Top 10 Draft Classes",
y = "Median WS", x = "Median PER") +
scale_color_brewer(palette = "Set3") + geom_text(check_overlap = T)
ggplotly(s4)
```
### Players
```{r scatter5, fig.align='center', out.width="90%", echo=FALSE}
NBA <- NBA %>% mutate(WS_per_G = career_WS / career_G)
best_NBAplayer <- NBA %>% group_by(name) %>% filter(draft_year > 1983, draft_pick < 61) %>% arrange(desc(WS_per_G), desc(career_PER)) %>% head(10)
s5 <- ggplot(best_NBAplayer, aes(x = career_PER, y = WS_per_G, label = name)) +
theme(text = element_text(size = 13)) +
labs(title = "Efficiency Distribution of Top 10 WS/G Players",
y = "WS / Games Played", x = "Career PER") +
scale_color_brewer(palette = "Set3") + geom_text(check_overlap = T)
ggplotly(s5)
```
About the Author
===
Column {.tabset data-width=500}
---
### My Background
My name is Jesse Devitt and I am an undergraduate student at the University
of Dayton. Currently, my projected graduation is May 2024.
Right now, I am working towards completing a B.S. in Applied Mathematical Economics
with minors in Data Analytics and AI & Data Science
I am interested in pursuing full time employment in the corporate data analytics field after my graduation.
Last summer, I worked as the general manager of water sports rental operation on the south side of Chicago, where I vastly improved my delegation, leadership, and client service skills. I hope to earn an internship position in a data-related field in Chicago for this summer. I am proficient in R, Java, and Excel, and will be taking a data structures course in Python next semester.
Feel free to connect with me on LinkedIn [here](https://www.linkedin.com/in/jesse-devitt-0a2305228/).
Column {.tabset data-width=500}
---
### Picture
```{r , fig.width=6, echo=FALSE, fig.cap="Jesse Devitt", fig.align='right'}
knitr::include_graphics("IMG_1803.jpeg")
```
